home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Whiteline: delta
/
whiteline CD Series - delta.iso
/
progtool
/
modula2
/
module
/
preiserf.mod
< prev
next >
Wrap
Text File
|
1995-11-25
|
12KB
|
408 lines
IMPLEMENTATION MODULE PreisErfassung;
(***************************** IMPORT ******************************)
FROM BlRscInc IMPORT VKPDIA , EKPDIA , (* TREE *) VKBIER , VKLIMO ,
CANCELVK , OKVK , EKB1 , EKB2 , EKB3 , EKB4 , EKB5 , EKB6 ,
EKB7 , EKL1 , EKL2 , EKL3 , EKL4 , EKL5 , EKL6 , EKL7 ,
CANCELEK , OKEK ,DATEDIA, DATUM, CANCDAT, OKDATUM,
SaveFileName;
FROM SYSTEM IMPORT ADDRESS;
FROM AES IMPORT FormAlert,ResourceGetAddr;
FROM EasyDialog IMPORT DoDialog,and,GetText,SetText,IsSelected;
FROM ConvertStr IMPORT StrToInt,IntToStr;
FROM Strings IMPORT IsEmptyStr,EqualStr,LeftStr,SubStr,ClearStr,Length,
Concat;
FROM InOut IMPORT WriteString,WriteLn,WriteInt,Done,ReadInt,
ReadLine,ReadString,
OpenOutput,CloseOutput,OpenInput,CloseInput;
(************************* VAR ********************************)
VAR EKDiaAddr : ADDRESS;
VKDiaAddr : ADDRESS;
EndStr : ARRAY [0..5] OF CHAR;
i,k : INTEGER;
(*************************** CONST ******************************)
(*************************** BEGIN ******************************)
PROCEDURE GetDate():BOOLEAN;
VAR String,SaveString :ARRAY [1..6] OF CHAR;
DateDiaAddr :ADDRESS;
DiaReturn :INTEGER;
dd,mm,jj :INTEGER;
OK,Valid :BOOLEAN;
Null,UnderScore : ARRAY [0..0] OF CHAR;
BEGIN
Null[0]:='0'; UnderScore[0]:='_';
ResourceGetAddr(0,DATEDIA,DateDiaAddr);
GetText(DATUM,DateDiaAddr,SaveString);
REPEAT
DiaReturn:=DoDialog(DateDiaAddr,DATUM);
Valid:=TRUE;
IF DiaReturn#CANCDAT THEN
GetText(DATUM,DateDiaAddr,String);
SubStr(String,1,2,DD,OK);
StrToInt(DD,dd,OK);
IntToStr(dd,2,DD,OK);
Valid:=Valid AND (dd<32);
SubStr(DD,2,2,DD,OK);
IF Length(DD)<2 THEN
Concat(Null,DD,DD,OK);
END(*IF*);
SubStr(String,3,2,MM,OK);
StrToInt(MM,mm,OK);
IntToStr(mm,2,MM,OK);
Valid:=Valid AND (mm<13);
SubStr(MM,2,2,MM,OK);
IF Length(MM)<2 THEN
Concat(Null,MM,MM,OK);
END(*IF*);
SubStr(String,5,2,JJ,OK);
StrToInt(JJ,jj,OK);
IntToStr(jj,2,JJ,OK);
Valid:=Valid AND (jj>93);
SubStr(JJ,2,2,JJ,OK);
IF Length(JJ)<2 THEN
Concat(Null,JJ,JJ,OK);
END(*IF*);
ELSE
SetText(DATUM,DateDiaAddr,SaveString);
END(*IF*);
IF Valid THEN
ClearStr(SaveFileName);
Concat(SaveFileName,JJ,SaveFileName,OK);
Concat(SaveFileName,UnderScore,SaveFileName,OK);
Concat(SaveFileName,MM,SaveFileName,OK);
Concat(SaveFileName,UnderScore,SaveFileName,OK);
Concat(SaveFileName,DD,SaveFileName,OK);
Concat(SaveFileName,'.DAT',SaveFileName,OK);
END(*IF*);
UNTIL Valid;
IF DiaReturn=CANCDAT THEN
RETURN FALSE
ELSE
RETURN TRUE
END(*IF*);
END GetDate;
PROCEDURE SetVkPreisText;
VAR OK:BOOLEAN;
VKPString : ARRAY [0..3] OF CHAR;
Null : ARRAY [0..0] OF CHAR;
BEGIN
ResourceGetAddr(0,VKPDIA,VKDiaAddr);
Null[0]:='0';
IntToStr( VerkaufsPreis.BierPreis,3,VKPString,OK);
SubStr(VKPString,2,3,VKPString,OK);
IF Length(VKPString)<3 THEN
Concat(Null,VKPString,VKPString,OK);
END(*IF*);
IF OK THEN
SetText(VKBIER,VKDiaAddr,VKPString);
END(*IF*);
IntToStr( VerkaufsPreis.LimoPreis,3,VKPString,OK);
SubStr(VKPString,2,3,VKPString,OK);
IF Length(VKPString)<3 THEN
Concat(Null,VKPString,VKPString,OK);
END(*IF*);
IF OK THEN
SetText(VKLIMO,VKDiaAddr,VKPString);
END(*IF*);
END SetVkPreisText;
PROCEDURE ValidInput(String:ARRAY OF CHAR;i:INTEGER):BOOLEAN;
VAR VglStr1,
VglStr2 : GTString;
IntStr : ARRAY[0..1] OF CHAR;
OK : BOOLEAN;
DM,Pf,FlProKast:INTEGER;
EKP1,
EKP2 : EKPreis;
BEGIN
VglStr1:='';VglStr2:='';
DM:=0;Pf:=0;FlProKast:=0;
IF IsEmptyStr(String) THEN RETURN FALSE END(*IF*);
LeftStr(String,16,VglStr1,OK);
IF IsEmptyStr(VglStr1) THEN RETURN FALSE END(*IF*);
VglStr2:='________________';
LeftStr(VglStr2,16,VglStr2,OK);
IF EqualStr(VglStr1,VglStr2) THEN RETURN FALSE END(*IF*);
VglStr2:=' ';
LeftStr(VglStr2,16,VglStr2,OK);
IF EqualStr(VglStr1,VglStr2) THEN RETURN FALSE END(*IF*);
SubStr(String,17,2,IntStr,OK);
StrToInt(IntStr,DM,OK);
SubStr(String,19,2,IntStr,OK);
StrToInt(IntStr,Pf,OK);
Pf:=100*DM+Pf;
SubStr(String,21,2,IntStr,OK);
StrToInt(IntStr,FlProKast,OK);
IF (Pf=0) OR (FlProKast=0) THEN RETURN FALSE END(*IF*);
EinKaufsPreis[i].TreeIndex:=i;
EinKaufsPreis[i].Getraenk:=VglStr1;
EinKaufsPreis[i].Preis:=Pf;
EinKaufsPreis[i].FlaschenProKasten:=FlProKast;
RETURN TRUE
END ValidInput;
PROCEDURE LoadPreise;
VAR s : ARRAY [0..255] OF CHAR;
String : ARRAY [0..21] OF CHAR;
Index : INTEGER;
OK : BOOLEAN;
i : INTEGER;
BEGIN
IF Done THEN
ReadInt(VerkaufsPreis.BierPreis);
ReadInt(VerkaufsPreis.LimoPreis);
END(*IF*);
SetVkPreisText;
ResourceGetAddr(0,EKPDIA,EKDiaAddr);
WHILE ~EqualStr(s, EndStr)AND Done DO
ReadLine(s);
LeftStr(s,22,String,OK);
ReadInt(Index);
i:=Index;
EinKaufsPreis[i].TreeIndex:=Index;
ReadInt(EinKaufsPreis[i].NeuBezogeneKaesten);
ReadInt(EinKaufsPreis[i].ZuBezahlendeKaesten);
ReadInt(EinKaufsPreis[i].KaestenGes);
EinKaufsPreis[i].KaestenGes:= EinKaufsPreis[i].KaestenGes+
EinKaufsPreis[i].NeuBezogeneKaesten;
EinKaufsPreis[i].ZuBezahlendeKaesten:= EinKaufsPreis[i].NeuBezogeneKaesten+
EinKaufsPreis[i].ZuBezahlendeKaesten;
EinKaufsPreis[i].NeuBezogeneKaesten:=0;
IF ValidInput(s,Index) THEN
SetText(Index,EKDiaAddr,String);
END(*IF*);
END(*WHILE*);
END LoadPreise;
PROCEDURE LoadOldPreise;
VAR s : ARRAY [0..255] OF CHAR;
String : ARRAY [0..21] OF CHAR;
Index : INTEGER;
OK : BOOLEAN;
BEGIN
IF Done THEN
ReadInt(VerkaufsPreis.BierPreis);
ReadInt(VerkaufsPreis.LimoPreis);
END(*IF*);
SetVkPreisText;
ResourceGetAddr(0,EKPDIA,EKDiaAddr);
WHILE ~EqualStr(s, '#&$!*')AND Done DO
ReadLine(s);
LeftStr(s,22,String,OK);
ReadInt(Index);i:=Index;
ReadInt(EinKaufsPreis[i].NeuBezogeneKaesten);
ReadInt(EinKaufsPreis[i].ZuBezahlendeKaesten);
ReadInt(EinKaufsPreis[i].KaestenGes);
IF ValidInput(s,Index) THEN
SetText(Index,EKDiaAddr,String);
END(*IF*);
END(*WHILE*);
END LoadOldPreise;
PROCEDURE SavePreise;
TYPE EinString = ARRAY [0..21] OF CHAR;
VAR s:ARRAY [0..255] OF CHAR;
i,preis:INTEGER;
String :EinString;
StrArray :ARRAY [1..14] OF EinString;
PROCEDURE WritePreis;
BEGIN
WriteString(String);WriteLn;
WriteInt(EinKaufsPreis[i].TreeIndex,7);
WriteInt(EinKaufsPreis[i].NeuBezogeneKaesten,7);
WriteInt(EinKaufsPreis[i].ZuBezahlendeKaesten,7);
WriteInt(EinKaufsPreis[i].KaestenGes,7);
WriteLn;
END WritePreis;
BEGIN
ClearStr(s);
IF Done THEN
WriteInt(VerkaufsPreis.BierPreis,10);
WriteInt(VerkaufsPreis.LimoPreis,10);
WriteLn;
END(*IF*);
ResourceGetAddr(0,EKPDIA,VKDiaAddr);
IF Done THEN
FOR i:=EKB1 TO EKB7 DO
GetText(i,EKDiaAddr,String);
IF ValidInput(String,i) THEN
WritePreis;
END(*IF*);
END(*FOR*);
FOR i:=EKL1 TO EKL7 DO
GetText(i,EKDiaAddr,String);
IF ValidInput(String,i) THEN
WritePreis;
END(*IF*);
END(*FOR*);
END(*IF*);
WriteString(EndStr);WriteLn;
WriteInt(0,3); WriteInt(0,3);
WriteInt(0,3); WriteInt(0,3);WriteLn;
END SavePreise;
PROCEDURE Nullbelegung(m:INTEGER);
BEGIN
EinKaufsPreis[m].NeuBezogeneKaesten:=0;
EinKaufsPreis[m].ZuBezahlendeKaesten:=0;
EinKaufsPreis[m].KaestenGes:=0;
EinKaufsPreis[m].Getraenk:=' ';
EinKaufsPreis[m].Preis:=0;
EinKaufsPreis[m].FlaschenProKasten:=0;
END Nullbelegung;
PROCEDURE Alert;
VAR fr :INTEGER;
formstr : ARRAY [0..127] OF CHAR;
BEGIN
formstr:='[1][ Sie können den Eintrag erst |löschen wenn diese Getränke| bezahlt sind !][ OK ]';
fr:=FormAlert(1,formstr)
END Alert;
PROCEDURE EinkaufsPreise;
VAR DiaReturn,i :INTEGER;
String :ARRAY [0..21] OF CHAR;
StringArray :ARRAY [EKB1..EKL7],[0..21] OF CHAR;
OK :BOOLEAN;
BEGIN
ResourceGetAddr(0,EKPDIA,EKDiaAddr);
FOR i:=EKB1 TO EKB7 DO
GetText(i,EKDiaAddr,StringArray[i]);
END(*FOR*);
FOR i:=EKL1 TO EKL7 DO
GetText(i,EKDiaAddr,StringArray[i]);
END(*FOR*);
DiaReturn:=DoDialog(EKDiaAddr,EKB1);
IF DiaReturn=OKEK THEN
FOR i:=EKB1 TO EKB7 DO
GetText(i,EKDiaAddr,String);
IF ~ValidInput(String,i) THEN
IF EinKaufsPreis[i].NeuBezogeneKaesten+
EinKaufsPreis[i].ZuBezahlendeKaesten # 0 THEN
Alert;
SetText(i,EKDiaAddr,StringArray[i]);
ELSE
Nullbelegung(i);
END(*IF*);
END(*IF*);
END(*FOR*);
FOR i:=EKL1 TO EKL7 DO
GetText(i,EKDiaAddr,String);
IF ~ValidInput(String,i) THEN
IF EinKaufsPreis[i].NeuBezogeneKaesten+
EinKaufsPreis[i].ZuBezahlendeKaesten # 0 THEN
Alert;
SetText(i,EKDiaAddr,StringArray[i]);
ELSE
Nullbelegung(i);
END(*IF*);
END(*IF*);
END(*FOR*);
ELSE
FOR i:=EKB1 TO EKB7 DO
SetText(i,EKDiaAddr,StringArray[i]);
END(*FOR*);
FOR i:=EKL1 TO EKL7 DO
SetText(i,EKDiaAddr,StringArray[i]);
END(*FOR*);
END(*IF*);
END EinkaufsPreise;
PROCEDURE VerkaufsPreise;
VAR DiaReturn :INTEGER;
preis :INTEGER;
String : ARRAY [0..2] OF CHAR;
OK : BOOLEAN;
BEGIN
ResourceGetAddr(0,VKPDIA,VKDiaAddr);
DiaReturn:=DoDialog(VKDiaAddr,VKBIER);
IF DiaReturn= OKVK THEN
GetText(VKBIER,VKDiaAddr,String);
StrToInt(String,preis,OK);
VerkaufsPreis.BierPreis:=preis;
GetText(VKLIMO,VKDiaAddr,String);
StrToInt(String,preis,OK);
VerkaufsPreis.LimoPreis:=preis;
ELSE
SetVkPreisText;
END(*IF*);
END VerkaufsPreise;
PROCEDURE GetPreferences(VAR Ordnen,LeerZeilen:INTEGER):BOOLEAN;
VAR DatumStr : ARRAY [0..6] OF CHAR;
Ordnen1,LeerZeilen1:INTEGER;
DateDiaAddr :ADDRESS;
OK : BOOLEAN;
InfoFileName : ARRAY[0..255] OF CHAR;
BEGIN
InfoFileName:='BIERKASS.INF';
OpenInput(InfoFileName);
IF Done THEN
ReadString(DatumStr);
ReadInt(Ordnen1);
ReadInt(LeerZeilen1);
IF Done THEN
ResourceGetAddr(0,DATEDIA,DateDiaAddr);
SetText(DATUM,DateDiaAddr,DatumStr);
Ordnen:=Ordnen1;
LeerZeilen:=LeerZeilen1;
END(*IF*);
ELSE
CloseInput;
RETURN FALSE
END(*IF*);
CloseInput;
RETURN TRUE
END GetPreferences;
PROCEDURE SetPreferences( Ordnen,LeerZeilen:INTEGER);
VAR DatumStr : ARRAY [1..6] OF CHAR;
DateDiaAddr :ADDRESS;
OK : BOOLEAN;
InfoFileName : ARRAY[0..255] OF CHAR;
BEGIN
InfoFileName:='BIERKASS.INF';
OpenOutput(InfoFileName);
IF Done THEN
ResourceGetAddr(0,DATEDIA,DateDiaAddr);
GetText(DATUM,DateDiaAddr,DatumStr);
WriteString(DatumStr);WriteLn;
WriteInt(Ordnen,5);
WriteInt(LeerZeilen,5);
END(*IF*);
CloseOutput;
END SetPreferences;
BEGIN
FOR k:= EKB1 TO EKL7 DO
EinKaufsPreis[k].TreeIndex:=0;
Nullbelegung(k);
END(*FOR*);
EndStr:='#&$!*';
END PreisErfassung.